Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Applications/P4⁄Mac 2.0d4/Mac source 2.0/TransDisplay.p

Text File | 1996-09-28 | 28.5 KB | 1,101 lines | [TEXT/PJMM]

{    TransDisplay version 1.0 - TransSkel plug-in module supporting}
{    an arbitrary number of generic display windows with memory.}

{    TransSkel and TransDisplay are public domain, and are written by:}

{            Paul DuBois}
{            Wisconsin Regional Primate Research Center}
{            1220 Capital Court}
{            Madison WI  53706  USA}

{    UUCP:        [allegra,ihnp4,seismo]!uwvax !uwmacc !dubois }
{    ARPA :     dubois @ unix.macc.wisc.edu }
{                dubois @ rhesus.primate.wisc.edu }

{    The Pascal Version of TransSkel is public domain and was ported by        }

{            Owen Hartnett            }
{            Ωhm Software            }
{            163 Richard Drive        }
{            Tiverton, RI 02878        }

{    CSNET:    [e-mail]                                             }
{    ARPA:        [e-mail]                        }
{    UUCP:        [ihnp4,allegra]!brunix !omh                                            }

{    Psychic Wavelength:  182.2245 Meters  (sorry, couldn't resist)    }

{    This version of TransDisplay written for Lightspeed Pascal.  Lightspeed Pascal}
{    is a trademark of:}
{            THINK Technologies, Inc}
{            420 Bedford Street  Suite 350}
{            Lexington, MA  02173  USA}


 { History}
{  08/25/86    Genesis.  Beta version.}
{  09/15/86    Changed to allow arbitrary number of windows.  Changed}
{             version number to 1.0.}
{  01/10/87    Ported to LightSpeed Pascal by Owen Hartnett                }
{    Ωhm Software, 163 Richard Drive, Tiverton, RI 02878                }
{  12/2/88    Made changes to add conditional compiling if you only need }
{            one TransDisplay window.  Set the following cond variable        }
{            singleDisplay to true if you want only one TransDisplay window }
{            and want smaller code size.    Made adjustments for LSP 2.0    }

{dec -94: Two seriou bugs fixed by Ingemar R, both causing problems with multiple TransDisplay windows:}
{– Mouse events could be sent to the wrong display window.}
{– SyncGlobals didn't check dispInfo for nil, which could cause crashes.}

unit TransDisplay;

interface

{$SETC singleDisplay:=false }
    uses
{$IFC UNDEFINED THINK_PASCAL}
        Types, QuickDraw, Windows, Dialogs, ToolUtils, Events, Controls, {}
        Memory, Sound, OSUtils, MixedMode,
{$IFC GENERATINGPOWERPC}
        PPCTransSkelCallProcs,
{$ENDC}
{$ELSEC}
{$SETC GENERATINGPOWERPC:=false }
        InterfacesUI,
{$ENDC}
        TransSkel;

    procedure SetDWindow (theWind: WindowPtr);
    procedure DisplayString (theStr: str255);
    procedure DisplayHexLong (l: longint);
    procedure DisplayHexInt (i: integer);
    procedure DisplayHexChar (c: char);
    procedure DisplayBoolean (b: Boolean);
    procedure DisplayChar (c: char);
    procedure DisplayInt (i: integer);
    procedure DisplayLong (l: longint);
    procedure DisplayLn;
    procedure DisplayText (theText: Ptr; len: longint);
    function GetNewDWindow (resourceNum: integer; behind: WindowPtr): WindowPtr;
    function NewDWindow (bounds: Rect; title: Str255; visible: Boolean; behind: WindowPtr; goAway: Boolean; refcon: longint): WindowPTr;
    procedure FlushDWindow (theWind: WindowPtr; byteCount: longint);
    procedure GetDWindow (var theWind: WindowPtr);
    procedure SetDWindowFlush (theWind: WindowPtr; maxText, flushAmt: longint);
    procedure SetDWindowNotify (theWind: WindowPTr; p: ProcPtr);
    procedure SetDWindowPos (theWind: WindowPtr; lineNum: integer);
    procedure SetDWindowStyle (theWind: WindowPtr; font, size, wrap, just: integer);
    function GetDWindowTE (theWind: WindowPtr): TEHandle;
    function IsDWindow (theWind: WindowPtr): Boolean;
    procedure TransDisplayInit;

implementation

{    Display window types, constants, variables.}

    const
        monaco = 4;

{$IFC not singleDisplay }
    type
        DIPtr = ^DisplayInfo;
        DIHandle = ^DIPtr;
        DisplayInfo = record
                dWind: WindowPtr;        { display window         }
                dTE: TEHandle;            { window text            }
                dScroll: ControlHandle;    { window scroll bar      }
                dActivate: ProcPtr;        { notification procedure }
                dMaxText: longint;        { max text length        }
                dFlushAmt: longint;        { amount to autoflush    }
                dNext: DIHandle;            { next window structure  }
            end;
{$ENDC}

    var

{ Look at TransDisplayInit procedure for initial values of these variables    }

        d_font, d_size: integer;                    { default font              }
                                                { default pointsize         }
        d_wrap, d_just: integer;                { default word wrap (on)    }
                                                { default justification     }
        d_maxText, d_flushAmt: longint;        { default max text allowed  }
                                                { default autoflush amount  }
        d_activate: ProcPtr;                    { default notification proc }

{    Lowest allowable values for autoflush characteristics}


        d_loMaxText, d_loFlushAmt: longint;

{$IFC not singleDisplay }

        dwList: DIHandle;

{    Variables pertaining to the display window being operated on}
{    (updated, resized, etc.).  This window is not necessarily the}
{    same as curDispWind!  These variables are synced to the window}
{    with SyncGlobals. }

        dispInfo: DIHandle;        { info structure         }
{$ENDC}

        dispWind: WindowPtr;            { the window             }
        dispTE: TEHandle;                { window text            }
        dispScroll: ControlHandle;        { the scroll bar         }
        dActivate: ProcPtr;                { notification procedure }
        dMaxText, dFlushAmt: longint;        { max text allowed       }
        { amount to flush        }

{    curDispWind is the current output window.}
{    If curDispWind = nil, output is turned off.}

        curDispWind: WindowPtr;

{ -------------------------------------------------------------------- }
{                Miscellaneous Internal (private) Routines                }
{ -------------------------------------------------------------------- }



{    Draw grow box of dispWind in lower right hand corner}

    procedure DrawGrowBox;

        var
            oldClip: RgnHandle;
            r: Rect;

    begin
        r := dispWind^.portRect;
        r.left := r.right - 15;        { draw only in corner }
        r.top := r.bottom - 15;
        oldClip := NewRgn;
        GetClip(oldClip);
        ClipRect(r);
        DrawGrowIcon(dispWind);
        SetClip(oldClip);
        DisposeRgn(oldClip);
    end;




{ -------------------------------------------------------------------- }
{            Lowest-level Internal (Private) Display Window Routines        }
{ -------------------------------------------------------------------- }

{$IFC not singleDisplay}

{    Get display window info associated with window.}
{    Return nil if window isn't a known display window.}

    function GetDInfo (theWind: WindowPtr): DIHandle;
        var
            h: DIHandle;
            foundit: Boolean;
    begin
        h := dwList;
        foundit := false;
        while (h <> nil) and not foundit do
            begin
                if h^^.dWind = theWind then
                    begin
                        GetDInfo := h;
                        h := nil;
                        foundit := true;
                    end
                else
                    h := h^^.dNext;
            end;
        if not foundit then
            GetDInfo := nil;                    {make it a nop    }
    end;
{$ENDC}

{$IFC singleDisplay}

    procedure SyncGlobals (theWind: WindowPtr);
    begin
    end;            { make it a nop }

{$ELSEC }
{    Synchronize globals to a display window.  theWind must be a legal}
{    display window, with one exception:  if theWind is nil, the}
{    variables are synced to the current port.  That is safe (and}
{    correct) because:}
{    (i)     nil is only passed by display window handler procedures,}
{         which are only called by TransSkel for display window}
{         events.}
{    (ii) TransSkel always sets the port to the window before}
{         calling the handler proc. <- NO LONGER TRUE!}
{    Hence, use of the current port under these circumstances}
{    always produces a legal display window.}

{    SyncGlobals is not used in single display mode, because the}
{    globals are all set by SetupDWindow and do not change thereafter.}

    procedure SyncGlobals (theWind: WindowPtr);

        var
            dp: DIPtr;
    begin
        if theWind = nil then                    { use current window }
            GetPort(theWind);
        dispWind := theWind;
        dispInfo := GetDInfo(dispWind);
{Bugfix by Ingemar 941208: The current port might not be a display window!}
        if dispInfo <> nil then
            begin
                dp := dispInfo^;
                dispScroll := dp^.dScroll;
                dispTE := dp^.dTE;
                dActivate := dp^.dActivate;
                dMaxText := dp^.dMaxText;
                dFlushAmt := dp^.dFlushAmt;
            end;
    end;
{$ENDC}

{    Calculate the dimensions of the editing rectangle for}
{    dispWind (which must be set properly and is assumed to }
{    the current port).  (The viewRect and destRect are the}
{    same size .) Assumes the port , text font and text size are all}
{    set properly.  The viewRect is sized so that an integral}
{    number of lines can be displayed in it, i.e., so that a}
{    partial line never shows at the bottom. }

    procedure CalcEditRect (var r: Rect);

        var
            f: FontInfo;
            lineHeight: integer;

    begin
        GetFontInfo(f);
        lineHeight := f.ascent + f.descent + f.leading;
        r := dispWind^.portRect;
        r.left := r.left + 4;
        r.right := r.right - 17;            { leave room for scroll bar + 2 }
        r.top := r.top + 2;
        r.bottom := r.top + ((r.bottom - (r.top - 2)) div lineHeight) * lineHeight;
    end;

{    Calculate the dimensions of the scroll bar rectangle for the}
{    window.  Make sure that the edges overlap the window frame and}
{    the grow box.}

    procedure CalcScrollRect (var r: Rect);

    begin
        r := dispWind^.portRect;
        r.right := r.right + 1;
        r.left := r.right - 16;
        r.top := r.top - 1;
        r.bottom := r.bottom - 14;
    end;

{    Calculate the number of lines currently scrolled off}
{    the top.}

    function LinesOffTop: integer;

        var
            ePtr: TEPtr;

    begin
        ePtr := dispTE^;
        LinesOffTop := (ePtr^.viewRect.top - ePtr^.destRect.top) div ePtr^.lineHeight;
    end;

{    Highlight the scroll bar properly.  This means that it's not}
{    made active if the window itself isn't active, even if}
{    there's enough text to fill the window. }

    procedure HiliteScroll;
        var
            result: integer;
    begin
        if (GetControlMaximum(dispScroll) > 0) and (dispWind = FrontWindow) then
            result := 0
        else
            result := 255;
        HiliteControl(dispScroll, result);
    end;

{    Scroll to the correct position.  lDelta is the}
{    amount to CHANGE the current scroll setting by.}
{    Positive scrolls the text up, negative down.}

    procedure ScrollText (lDelta: integer);

        var
            lHeight, newLine, topLine: integer;

    begin
        lHeight := dispTE^^.lineHeight;
        topLine := LinesOffTop;
        newLine := topLine + lDelta;
        if newLine < 0 then
            newLine := 0;
        if newLine > GetControlMaximum(dispScroll) then
            newLine := GetControlMaximum(dispScroll);
        SetControlValue(dispScroll, newLine);
        TEScroll(0, (topLine - newLine) * lHeight, dispTE);
    end;


{    Filter proc for tracking mousedown in scroll bar . The code}
{    for the part originally hit is stored in the control 's reference}
{    value by Mouse ( ) before calling this . }


{    Scroll by one line if the mouse is in an arrow.  Scroll by a half}
{    window's worth of lines if the mouse is in a page region. }

    procedure TrackScroll (theScroll: ControlHandle; partCode: integer);

        var
            lDelta, halfPage: integer;

    begin
        if partCode = GetControlReference(theScroll) then        { still in same part? }
            begin
                halfPage := ((dispTE^^.viewRect.bottom - dispTE^^.viewRect.top) div dispTE^^.lineHeight) div 2;
                if halfPage = 0 then
                    halfPage := halfPage + 1;
                case partCode of
                    kControlUpButtonPart:
                        lDelta := -1;
                    kControlDownButtonPart:
                        lDelta := 1;
                    kControlPageUpPart:
                        lDelta := -halfPage;
                    kControlPageDownPart:
                        lDelta := halfPage;
                    otherwise
                end;
                ScrollText(lDelta);
            end;
    end;

{    Adjust the text in the text record and the scroll bar.  This is}
{    called for major catastrophes, such as resizing the window, or}
{    changing the word wrap style.  It makes sure the view and}
{    destination rectangles are sized properly, and that the bottom}
{    line of text never scrolls up past the bottom line of the}
{    window, if there's enough to fill the window, and that the}
{    scroll bar max and current values are set properly.}

{    Resizing the dest rect just means resetting the right edge}
{    (the top is NOT reset), since text might be scrolled off the}
{    top (i.e., destRect.top != 0).}

    procedure OverhaulDisplay;

        var
            r: Rect;
            nLines, visLines, topLines, scrollLines, lHeight: integer;
            { number of lines in TERec }
        { number of lines displayable in window }
        { number of lines currently scrolled off top }
        { number of lines to scroll down }

    begin
        CalcEditRect(r);
        dispTE^^.destRect.right := r.right;
        dispTE^^.viewRect := r;
        TECalText(dispTE);        { recalc line starts }
        lHeight := dispTE^^.lineHeight;
        nLines := dispTE^^.nLines;
        visLines := (r.bottom - r.top) div lheight;
        topLines := LinesoffTop;

{    If the text doesn't fill the window (visLines > nLines - topLines),}
{    pull the text down if possible (if topLines > 0).  Make sure}
{    not to try to scroll down by more lines than are hidden off the top .}

        scrollLines := visLines - (nLines - topLines);
        if (scrollLines > 0) and (topLines > 0) then
            begin
                if scrollLines > topLines then
                    scrollLines := topLines;
                TEScroll(0, scrollLInes * lHeight, dispTE);
                toplines := topLines - scrollLines;
            end;
        TEUpdate(r, dispTE);
        if nLines - visLines < 0 then
            SetControlMaximum(dispScroll, 0)
        else
            SetControlMaximum(dispScroll, nLines - VisLines);
        SetControlValue(dispScroll, topLines);
        HiliteScroll;
    end;

{$IFC GENERATINGPOWERPC = false}
    procedure callpnoarg (myProc: ProcPtr);
{ For all the Procedures that are called with no arguments                        }
    inline
        $205f,     {movea.l  (a7)+,a0        ; (a0) is a ptr to string, 4(a0) is mode}
        $4e90;

    procedure callpBoolean (myBool: Boolean; myProc: ProcPtr);
{ Two calls use Booleans as one parameter arguments.  This procedure handles    }
{ both of them.                                                                    }
    inline
        $205f,     {movea.l  (a7)+,a0        ; (a0) is a ptr to string, 4(a0) is mode}
        $4e90;
{$ENDC}

{ ---------------------------------------------------------------- }
{                        Window Handler Routines                        }
{ ---------------------------------------------------------------- }



{    When the window comes active, highlight the scroll bar appropriately.}
{    When the window is deactivated, un-highlight the scroll bar.}
{    Redraw the grow box.}

{    Notify the host as appropriate.}

{    Note that clicking close box hides the window, which generates a}
{    deactivate event, so there is no need for a close notifier.}


    procedure Activate (isActive: Boolean);

    begin
        SyncGlobals(nil);                { sync to current port }
        DrawGrowBox;
        HiliteScroll;

        if dActivate <> nil then
            callpBoolean(isActive, dActivate);
    end;

{    Update window.  The update event might be in response to a}
{    window resizing.  If so, move and resize the scroll bar,}
{    and recalculate the text display.}

{    The ValidRect call is done because the HideControl adds the}
{    control bounds box to the update region - which would generate}
{    another update event!  Since everything is redrawn below anyway,}
{    the ValidRect is used to cancel the update.}

    procedure Update (resized: Boolean);

        var
            r: Rect;

    begin
        SyncGlobals(nil);                    { sync to current port }
        r := dispWind^.portRect;
        EraseRect(r);
        if resized then
            begin
                HideControl(dispScroll);
                r := dispScroll^^.contrlRect;
                ValidRect(r);
                CalcScrollRect(r);
                SizeControl(dispScroll, 16, r.bottom - r.top);
                MoveControl(dispScroll, r.left, r.top);
                OverHaulDisplay;
                ShowControl(dispScroll);
            end
        else
            begin
                r := dispTE^^.viewRect;
                TEUpdate(r, dispTE);
            end;
        DrawGrowBox;
        DrawControls(dispWind);    { redraw scroll bar }
    end;

{    Handle mouse clicks in window}

    procedure Mouse (thePt: Point; t: longint; mods: integer);

        var
            thePart: integer;
            oldCtlValue: integer;
    begin
        SyncGlobals(nil);                    { Sync to current port    }

        thePart := TestControl(dispScroll, thePt);
        if thePart = kControlIndicatorPart then
            begin
                OldCtlValue := GetControlValue(dispScroll);
                if TrackControl(dispScroll, thePt, nil) = kControlIndicatorPart then
                    ScrollText(GetControlValue(dispScroll) - oldCtlValue);
            end
        else if thePart <> 0 then
            begin
                SetControlReference(dispScroll, longint(thePart));
                oldCtlValue := TrackControl(dispScroll, thePt, @TrackScroll);
            end;
    end;

{    Remove the display window from the list, and dispose of it.}
{    Since the clobber procedure is never called except for real display}
{    windows, and since the list must therefore be non-empty, it is}
{    not necessary to check the legality of the window or that the}
{    window's in the list.}

{    Must do SetDWindow (nil) to turn output off, if the window being}
{    clobbered is the current output window.}

    procedure Clobber;

        var
{$IFC not singleDisplay}
            h, h2: DIHandle;
{$ENDC}
            keepgoing: Boolean;

    begin
        SyncGlobals(nil);                    { sync to current port }
        if dispWind = curDispWind then    { is it the first window in list? }
            SetDWindow(nil);
{$IFC not singleDisplay}
        if dwList^^.dWind = dispWind then    { found it }
            begin
                h2 := dwList;
                dwList := dwList^^.dNext;
            end
        else
            begin
                h := dwList;
                keepgoing := true;
                while (h <> nil) and keepgoing do
                    begin
                        h2 := h^^.dNext;
                        if h2^^.dWind = dispWind then
                            begin
                                h^^.dNext := h2^^.dNext;
                                keepgoing := false;
                            end;
                        h := h2;
                    end;
            end;
        DisposeHandle(Handle(h2));        { get rid of information structure }
{$ENDC}
        TEDispose(dispTE);                { toss text record }
        DisposeWindow(dispWind);        { toss window and scroll bar }
        dispWind := nil;
    end;

{ ---------------------------------------------------------------- }
{                            Control Routines                        }
{ ---------------------------------------------------------------- }


{    Test whether a window is a legal display window or not }

    function IsDWindow;

    begin
{$IFC singleDisplay}
        IsDWindow := (theWind = dispWind) and (dispWind <> nil);
{$ELSEC}
        IsDWindow := GetDInfo(theWind) <> nil;
{$ENDC}
    end;

{    Return handle to display window's text record}

    function GetDWindowTE;

{$IFC not singleDisplay}

        var
            dInfo: DIHandle;
{$ENDC}

    begin
{$IFC not singleDisplay}

{Fix by Ingemar -94: The following line was missing in the 2.0 release:}
        dInfo := GetDInfo(theWind);

        if dInfo = nil then {GetDInfo(theWind)}
            GetDWindowTE := nil
        else
            GetDWIndowTE := dInfo^^.dTE;
{$ELSEC}
        if ISDWindow(theWind) then
            GetDWindowTE := dispTE
        else
            GetDWindowTE := nil;
{$ENDC}
    end;

{    Change the text display characteristics of a display window}
{    and redisplay it.  As a side effect, this always scrolls to the}
{    home position.}

    procedure SetDWindowStyle;

        var
            savePort: GrafPtr;
            f: FontInfo;
            te: TEHandle;
            r: Rect;

    begin
        if theWind = nil then            { reset window creation defaults }
            begin
                d_font := font;
                d_size := size;
                d_wrap := wrap;
                d_just := just;
            end
        else
            begin
                if IsDWindow(theWind) then
                    begin
                        GetPort(savePort);
                        SyncGlobals(theWind);
                        SetPort(dispWind);
                        te := dispTE;
                        r := te^^.viewRect;
                        EraseRect(r);
                        r := te^^.destRect;    { scroll home without redrawing }

                        OffsetRect(r, 0, 2 - r.top);
                        te^^.destRect := r;
                        te^^.crOnly := wrap;    { set word wrap }
                        TESetAlignment(just, te);    { set justification TESetJust}
                        TextFont(font);         { set the font and point size }
                        TextSize(size);        { of text record (this is the }
                        GetFontInfo(f);        { hard part) }
                        te^^.lineHeight := f.ascent + f.descent + f.leading;
                        te^^.fontAscent := f.ascent;
                        te^^.txFont := font;
                        te^^.txSize := size;

                        OverhaulDisplay;
                        SetPort(savePort);
                    end;
            end;
    end;

{    Scroll the text in the window so that line lineNum is at the top.}
{    First line is line zero.}

    procedure SetDWindowPos;

        var
            savePort: GrafPtr;

    begin
        if IsDWindow(theWind) then
            begin
                GetPort(savePort);
                SyncGlobals(theWind);
                SetPort(dispWind);
                ScrollText(lineNum - GetControlValue(dispScroll));
                SetPort(savePort);
            end;
    end;

{    Set display window activate notification procedure.}
{    Pass nil to disable it.}

    procedure SetDWindowNotify;
{$IFC not singleDisplay}
        var
            dInfo: DIHAndle;
{$ENDC}

    begin
        if theWind = nil then            { reset window creation default }
            d_activate := p
        else
            begin
{$IFC singleDisplay}
                if (ISDWindow(theWind)) then
                    dActivate := p;
{$ELSEC}
                dInfo := GetDInfo(theWind);
                if dInfo <> nil then
                    dInfo^^.dActivate := p;
{$ENDC}
            end;
    end;

{    Set display window autoflush characteristics}

    procedure SetDWindowFlush;

{$IFC not singleDisplay}
        var
            dInfo: DIHandle;
{$ENDC}

    begin
        if maxText > longint(32767) then
            maxText := 32767;
        if maxText < d_loMaxText then
            maxText := d_loMaxText;
        if flushAmt < d_loFlushAmt then
            flushAmt := d_loFlushAmt;
        if theWind = nil then
            begin            { reset window creation defaults }
                d_maxText := maxText;
                d_flushAmt := flushAmt;
            end
        else
            begin
{$IFC singleDisplay}
                if (IsDWindow(theWind)) then
                    begin
                        dMaxText := maxText;
                        dFlushAmt := flushAmt;
                    end;
{$ELSEC}
                dInfo := GetDInfo(theWind);
                if dInfo <> nil then
                    begin
                        dInfo^^.dMaxText := maxText;
                        dInfo^^.dFlushAmt := flushAmt;
                    end;
{$ENDC}
            end;
    end;

{    Set which display window is to be used for output.  If theWind}
{    is nil, output is turned off.  If theWind is not a legal display}
{    window, nothing is done.}

    procedure SetDWindow;

    begin
        if (theWind = nil) or IsDWindow(theWind) then
            curDispWind := theWind;
    end;

{    Get the WindowPtr of the current output display window.  If}
{    output is turned off, this will be nil.}

    procedure GetDWindow;

    begin
        theWind := curDispWind;
    end;

{    Flush text from the window and readjust the display.}

    procedure FlushDWindow;

    begin
        if IsDWindow(theWind) then
            begin
                SyncGlobals(theWind);
                TESetSelect(longint(0), byteCount, dispTE);    { select text }
                TEDelete(dispTE);                                { clobber it }
                OverhaulDisplay;
            end;
    end;

{    Create and initialize a display window and the associated data}
{    structures, and return the window pointer.  Install window in}
{    list of display windows.}

    procedure SetupDWindow;

        var
            r: Rect;
            savePort: GrafPtr;
{$IFC not singleDisplay}
            dInfo: DIHandle;
{$ENDC}
            dummy: Boolean;

    begin
        dummy := SkelWindow(dispWind, @Mouse, nil, @Update, @Activate, nil, @Clobber, nil, false);
    { the window }
        { mouse click handler }
        { key clicks are ignored }
        { window updating procedure }
        { window activate/deactivate procedure }
        { TransSkel hides window if no close proc }
        { (generates deactivate event) }
        { window disposal procedure }
        { no idle proc }
        { irrelevant since no idle proc }

{    Build the scroll bar.  Make sure the borders overlap the}
{    window frame and the frame of the grow box.}

        CalcScrollRect(r);
        dispScroll := NewControl(dispWind, r, '', true, 0, 0, 0, scrollBarProc, longint(0));

{    Create the TE record used for text display.  Use defaults for}
{    display characteristics.  Setting window style overhauls}
{    display, so can cancel and update event pending for the window.}

        CalcEditRect(r);
        dispTE := TENew(r, r);

{$IFC not singleDisplay}
{    Get new information structure, attach to list of known display}
{    windows.}

        dInfo := DIHandle(NewHandle(sizeof(DisplayInfo)));

        dInfo^^.dNext := dwList;
        dwList := dInfo;
        dInfo^^.dWind := dispWind;
        dInfo^^.dScroll := dispScroll;
        dInfo^^.dTE := dispTE;
{$ENDC}

        SetDWindowNotify(dispWind, d_activate);
        SetDWindowFlush(dispWind, d_maxtext, d_flushAmt);
        SetDWindowStyle(dispWind, d_font, d_size, d_wrap, d_just);

{    Make window current display output window}

        SetDWindow(dispWind);
    end;

{    Create and initialize a display window and the associated data}
{    structures, and return the window pointer.  Install window in}
{    list of display windows.  In single-window mode, disallow}
{    creation of a new window if one already exists.}

{    The parameters are similar to those for NewWindow.  See Inside}
{    Macintosh.}

    function NewDWindow;

    begin
{$IFC singleDisplay}
        if dispWind <> nil then
            NewDWindow := nil
        else
{$ENDC}
            begin
                dispWind := NewWindow(nil, bounds, title, visible, documentProc, behind, goAway, refCon);
                SetUpDWindow;
                NewDWindow := dispWind;
            end;
    end;

{    Create and initialize a display window (using a resource) and}
{    the associated data structures, and return the window pointer.}
{    Install window in list of display windows.  In single-window}
{    mode, disallow creation of a new window if one already exists.}

{    The parameters are similar to those for GetNewWindow.  See Inside}
{    Macintosh.}

    function GetNewDWindow;

    begin
{$IFC singleDisplay}
        if dispWind <> nil then
            GetNewDWindow := nil
        else
{$ENDC}
            begin
                dispWind := GetNewWindow(resourceNum, nil, behind);
                SetUPDWindow;
                GetNewDWindow := dispWind;
            end;
    end;

{ ------------------------------------------------------------ }
{                        Output Routines                            }
{ ------------------------------------------------------------ }


{}
{    Write text to display area if output is on (curDispWind != nil).}
{    DisplayText is the fundamental output routine.  All other}
{    output calls map (eventually) to it.}

{    First check whether the insertion will cause overflow and flush}
{    out some stuff if so.  Insert new text at the end, then test}
{    whether lines must be scrolled to get the new stuff to show up.}
{    If yes, then do the scroll.  Set values of scroll bar properly}
{    and highlight as appropriate.}

{    The current port is preserved.  Since all output calls end up}
{    here, it's the only output routine that has to save the port}
{    and check whether output is on.}

    procedure DisplayText;

        var
            nLines, dispLines, topLines, scrollLines, lHeight: integer;
        { number of lines in TERec }
        { number of lines displayable in window }
        { number of lines currently scrolled off top }
        { number of lines to scroll up }
            r: Rect;
            savePort: GrafPtr;
            dTE: TEHandle;

    begin
        if curDispWind <> nil then
            begin
                GetPort(savePort);
                SetPort(curDispWind);
                SyncGlobals(curDispWind);
                dTE := dispTE;

                if dTE^^.teLength + len > dMaxText then    { check overflow }
                    begin
                        FlushDWindow(dispWind, dFlushAmt);
                        DisplayString('(autoflush occurred)');
                    end;
                lHeight := dTE^^.lineHeight;
                TESetSelect(longint(32767), longint(32767), dTE);
                TEInsert(theText, len, dTE);
                r := dTE^^.viewRect;
                nLines := dTE^^.nLines;
                dispLines := (r.bottom - r.top) div lHeight;
                topLines := LinesOffTop;
                scrollLines := nLines - (topLines + dispLines);
                if scrollLines > 0 then                                 { must scroll up }
                    TEScroll(0, -lHeight * scrollLines, dTE);            { scroll up }
                topLines := nLines - dispLines;
                if (topLines >= 0) and (GetControlMaximum(dispScroll) <> topLines) then
                    begin
                        SetControlMaximum(dispScroll, topLines);
                        SetControlValue(dispScroll, topLines);
                    end;
                HiliteScroll;
                SetPort(savePort);
            end;
    end;

{    Derived output routines:}

{    DisplayString    Write (Pascal) string}

{    DisplayLong        Write value of long integer}
{    DisplayInt        Write value of integer}
{    DisplayChar        Write character}

{    DisplayHexLong    Write value of long integer in hex (8 digits)}
{    DisplayHexInt    Write value of integer in hex (4 digits)}
{    DisplayHexChar    Write value of character in hex (2 digit)}

{    DisplayBoolean    Write boolean value}
{    DisplayLn        Write carriage return}

    procedure DisplayString;

        var
            myPtr: Ptr;

    begin
        myPtr := Ptr(longint(@theStr) + 1);
        DisplayText(myPtr, longint(length(theSTr)));
    end;

    procedure DisplayLong;

        var
            s: Str255;

    begin
        NumToString(l, s);
        DisplayString(s);
    end;

    procedure DisplayInt;

    begin
        DisplayLong(longint(i));
    end;

    procedure DisplayChar;

        var
            myPtr: Ptr;

    begin
        myPtr := @c;
        myPtr := Ptr(longint(myPtr) + 1);
        DisplayText(myPtr, longint(1));
    end;

    procedure DisplayLn;

    begin
        DisplayChar(char(13));
    end;

    procedure DisplayBoolean;

    begin
        if b then
            DisplayString('True')
        else
            DisplayString('False');
    end;

    procedure HexByte (value: integer);    {value should be 0..15}
    begin
        if value < 10 then
            DisplayChar(char(value + integer('0')))
        else
            DisplayChar(char(value + (integer('a') - 10)));
    end;

    procedure DisplayHexChar;

    begin
        HexByte(integer(BitAnd(BitShift(longint(c), -4), $0000000f)));
        HexByte(integer(BitAnd(longint(c), $0000000f)));
    end;

    procedure DisplayHexInt;

    begin
        DisplayHexChar(char(BitAnd(BitShift(longint(i), -8), $000000ff)));
        DisplayHexChar(char(BitAnd(longint(i), $000000ff)));
    end;

    procedure DisplayHexLong;

    begin
        DisplayHexInt(Integer(BitAnd(BitShift(l, -16), $0000ffff)));
        DisplayHexInt(integer(LoWord(l)));
    end;

    procedure TransDisplayInit;

    begin

{    Default values for display window characteristics}

        d_font := monaco;        { default font              }
        d_size := 9;                { default pointsize         }
        d_wrap := 0;                { default word wrap (on)    }
        d_just := teJustLeft;    { default justification     }
        d_maxText := 30000;    { default max text allowed  }
        d_flushAmt := 25000;    { default autoflush amount  }
        d_activate := nil;        { default notification proc }

{    Lowest allowable values for autoflush characteristics}

        d_loMaxText := 100;
        d_loFlushAmt := 100;

{    dwList points to a list of structures describing the known display}
{    windows.}

{    curDispWind is the current output window.}
{    If curDispWind = nil, output is currently turned off.}

{$IFC not singleDisplay}
        dwList := nil;
{$ENDC}
        dispWind := nil;
        curDispWind := nil;
    end;
end.